metStrip <- function(x, 
                     date, 
                     origin, 
                     cond = rep(" ", length(x)),
                     colour = colorRampPalette(c("darkblue", "darkseagreen", 
                                                 "gold", "darkred"),
                                               interpolate = "linear"),
                     ...) {
  
################################################################################
##  
##  This program plots meteorological parameters as
##  a function of time of day (y-axis) and day of year (x-axis). Values are
##  colour shaded from minimum to maximum. It is possible to supply a
##  conditioning variable (as this function uses trellis plotting).
##  NOTE: observations must be hourly or higher frequency!
##  
##  parameters are as follows:
##  
##  x (numeric):          Object to be plotted (e.g. temperature).
##  date (character):     Date(time) of the observations.
##                        Format must be 'YYYY-MM-DD hh:mm:ss'
##  origin (character):   All time calculations will be done using this origin.
##                        This is needed especially for the month bars dividing 
##                        the panels. Must be the 1st of Jan of any given year.
##  cond (factor):        Conditioning variable (optional).
##  colour (character):   Defaults to classical temperature colour palette.
##
################################################################################
##
##  Copyright (C) 2011 Tim Appelhans, Thomas Nauss
##
##  This program is free software: you can redistribute it and/or modify
##  it under the terms of the GNU General Public License as published by
##  the Free Software Foundation, either version 3 of the License, or
##  (at your option) any later version.
##
##  This program is distributed in the hope that it will be useful,
##  but WITHOUT ANY WARRANTY; without even the implied warranty of
##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
##  GNU General Public License for more details.
##
##  You should have received a copy of the GNU General Public License
##  along with this program.  If not, see <http://www.gnu.org/licenses/>.
##
##  Please send any comments, suggestions, criticism, or (for our sake) bug
##  reports to tim.appelhans@gmail.com
##
################################################################################

  cat("\n",
      "Module   :  metStrip", "\n",
      "Author   :  Tim Appelhans <tim.appelhans@gmail.com>, Thomas Nauss", "\n",
      "Version  :  2011-11-24", "\n",
      "License  :  GNU GPLv3, see http://www.gnu.org/licenses/", "\n")
  
########## FUNCTION BODY #######################################################
  
  ## load packages needed (produce error message if not installed)
  stopifnot(require(latticeExtra))
  stopifnot(require(grid))
  
  ## set system locale time zone to "UTC" for time handling w/out
  ## daylight saving - save current (old) time zone setting
  Old.TZ <- Sys.timezone()
  Sys.setenv(TZ = "UTC")
  
  ## calculate different times objects
  juldays <- as.Date(date, origin = as.Date(origin))
  jul <- julian(juldays, origin = as.Date(origin))
  unldate <- lapply(as.POSIXlt(date), "unlist")
  hour <- unldate$hour
  
  ## calculate times objects to use for axes, labelling & monthblocks
  xat <- seq.Date(as.Date(origin), juldays[length(juldays)], by = "month")
  xat <- format(xat, "%j")
  xat <- as.numeric(xat)
  xat <- subset(xat, xat > min(jul))
  xlabs <- format(as.Date(xat, origin = as.Date(origin)), "%b")
  xat <- xat - min(jul)

  xblockx <- sort((jul - min(jul) +1))
  xbar <- sort(juldays)
  xbar <- months(xbar)

  ## create contingency table of observations averaged over one hour
  strip_z <- xtabs(x ~ juldays + hour + cond, na.action = na.pass) / 
               xtabs(~ juldays + hour + cond, na.action = na.pass)
  
  ## get rid of possible junk in cond variable
  con <- unique(cond)
  con <- subset(con, con != NA | con != "")
  
  ## create strip (will only be proper strip if enough observations)
  plot <- levelplot(strip_z, subset = cond != "", ylim = c(-0.5, 24.5),
                    layout = c(1,length(con)),
                    col.regions = colour, #asp = 30, 
                    strip = F, ylab = "Hour of day", xlab = "Day of year",
                    strip.left = strip.custom(
                      bg = "darkblue", 
                      par.strip.text = list(col = "white", font = 2, cex = 0.8)),
                    as.table = T, cuts = 200,
                    between = list(x = 0, y = 0),
                    scales = list(
                      x = list(at = xat, labels = xlabs),
                      y = list(at = c(6, 12, 18))),
                    colorkey = list(space = "top", width = 1),
                    panel = function(x, ...) {
                      panel.levelplot(x, ...)
                      panel.xblocks(xblockx, y = xbar, 
                                    height = unit(1, "native"),
                                    col = c("black", "white"), 
                                    border = "grey20", hjust = 0, 
                                    vjust = -0, outside = T)
                      #panel.abline(h = c(6, 18), lty = 2, lwd = 0.5, 
                      #             col = "grey30")
                    },
  ...) 
  
  ## revert system local time zone setting to original
  Sys.setenv(TZ = Old.TZ)
  
  ## return plot - print will also produce plot when source()'d
  return(print(plot))
}

## EXAMPLE ##

## set input path
#inpath <- "e:/kili_data/testing/overview/"
#inpath <- "~/ui_data_kilimanjaro/processing/plots/ki/"
#inpath <- "c:/tappelhans/uni/marburg/lehre/2011/ws/r_course/presentations/06_exercise/data/"

## list all file in input path (and sub folders) justifying pattern definition
#a <- list.files(inpath, recursive = T, pattern = "ca01_nai05_0010")

## read all files into a list
#y <- lapply(1:length(a), function(i) read.table(paste(inpath,a[i],sep="/"), 
#                                                header = T, sep = ",", fill = T))

## rbind all list entries
#dat <- do.call("rbind", y)

## call function
# metStrip(x = dat$t_rug, 
#          date = dat$dateEAT, 
#          cond = dat$plotID, 
#          origin = "2011-01-01")
